home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
remote
/
ratotp.zip
/
GETWORD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-07-14
|
2KB
|
90 lines
{ GetWord - Several String Manipulations }
{ Captured from FidoNet PASCAL echo }
{ Public Domain, I assume }
{ courtesy of RodentWare }
{ Michae Reece / James Calvert }
Unit GetWord;
interface
function Get_Word(st:string; num:integer):string;
function Del_Space(st:string; fb:integer):string;
procedure No_space(var st:string);
implementation
function Get_Word(st:string; num:integer):string;
var
i,a : integer;
tmp : string[15];
begin
tmp := '';
i := 0;
a := 0;
if num = 1 then
begin { if first word wanted }
repeat;
inc(i);
if st[i] <> #32 then
tmp := tmp + st[i];
until (st[i] = #32) or (i = ord(st[0]));
end
else
begin
repeat;
inc(i); { if any others wanted }
if st[i] = #32 then
inc(a);
until (a = num-1) or (i = ord(st[0]));
repeat;
inc(i);
if st[i] in [#33..#94,#97..#126] then
tmp := tmp + st[i];
until (st[i] = #32) or (i = ord(st[0]));
end;
Get_Word := tmp;
end;
function Del_Space(st:string; fb:integer):string;
var
i,a,x : integer;
tmp : string[15];
begin { fb = 0....del leading }
tmp := st; { fb = 1....del trailing }
i := 1; { fb = 2....do both }
if (fb = 0) or (fb = 2) then
begin
while st[i] = #32 do
begin
inc(i);
end;
tmp := copy(st,i,ord(st[0]));
end;
if (fb = 1) or (fb = 2) then
begin
a := ord(tmp[0]);
while tmp[a] = #32 do
begin
dec(a);
end;
tmp := copy(tmp,1,a);
end;
Del_Space := tmp;
end;
{ procedure No_Space - Removes all double spaces from St }
{ added by Michael Reece, RodentWare }
procedure no_space(var st:string);
var x,y,z : integer;
begin
for x:=1 to length(st) do
begin
If (St[x]=#32) and (st[x+1]=#32) then
delete(St,x,1);
end;
end;
end.